Temel Bilesenler Analizi,Bagimsiz Bilesenler Analizi
Temel Bilesenler Analizi
library(dplyr)
library(FactoMineR) #PCA icin lullanilan paket.
library(factoextra) #Grafikler icin gerekli paket.
library(ggplot2)
library(RColorBrewer) #Renklerin bulundugu paket
library(fastICA) #ICA icin kullanilan paket
library("MASS")Verinin Okutulması
Kaynak:[(https://www.kaggle.com/uciml/breast-cancer-wisconsin-data)]
## 'data.frame': 569 obs. of 32 variables:
## $ id : int 842302 842517 84300903 84348301 84358402 843786 844359 84458202 844981 84501001 ...
## $ diagnosis : chr "M" "M" "M" "M" ...
## $ radius_mean : num 18 20.6 19.7 11.4 20.3 ...
## $ texture_mean : num 10.4 17.8 21.2 20.4 14.3 ...
## $ perimeter_mean : num 122.8 132.9 130 77.6 135.1 ...
## $ area_mean : num 1001 1326 1203 386 1297 ...
## $ smoothness_mean : num 0.1184 0.0847 0.1096 0.1425 0.1003 ...
## $ compactness_mean : num 0.2776 0.0786 0.1599 0.2839 0.1328 ...
## $ concavity_mean : num 0.3001 0.0869 0.1974 0.2414 0.198 ...
## $ concave.points_mean : num 0.1471 0.0702 0.1279 0.1052 0.1043 ...
## $ symmetry_mean : num 0.242 0.181 0.207 0.26 0.181 ...
## $ fractal_dimension_mean : num 0.0787 0.0567 0.06 0.0974 0.0588 ...
## $ radius_se : num 1.095 0.543 0.746 0.496 0.757 ...
## $ texture_se : num 0.905 0.734 0.787 1.156 0.781 ...
## $ perimeter_se : num 8.59 3.4 4.58 3.44 5.44 ...
## $ area_se : num 153.4 74.1 94 27.2 94.4 ...
## $ smoothness_se : num 0.0064 0.00522 0.00615 0.00911 0.01149 ...
## $ compactness_se : num 0.049 0.0131 0.0401 0.0746 0.0246 ...
## $ concavity_se : num 0.0537 0.0186 0.0383 0.0566 0.0569 ...
## $ concave.points_se : num 0.0159 0.0134 0.0206 0.0187 0.0188 ...
## $ symmetry_se : num 0.03 0.0139 0.0225 0.0596 0.0176 ...
## $ fractal_dimension_se : num 0.00619 0.00353 0.00457 0.00921 0.00511 ...
## $ radius_worst : num 25.4 25 23.6 14.9 22.5 ...
## $ texture_worst : num 17.3 23.4 25.5 26.5 16.7 ...
## $ perimeter_worst : num 184.6 158.8 152.5 98.9 152.2 ...
## $ area_worst : num 2019 1956 1709 568 1575 ...
## $ smoothness_worst : num 0.162 0.124 0.144 0.21 0.137 ...
## $ compactness_worst : num 0.666 0.187 0.424 0.866 0.205 ...
## $ concavity_worst : num 0.712 0.242 0.45 0.687 0.4 ...
## $ concave.points_worst : num 0.265 0.186 0.243 0.258 0.163 ...
## $ symmetry_worst : num 0.46 0.275 0.361 0.664 0.236 ...
## $ fractal_dimension_worst: num 0.1189 0.089 0.0876 0.173 0.0768 ...
## [1] 569 32
Verimiz 32 degiskenden olusmaktadır.Temel bilesenleri çok değişkenli bir veri setinde boyut indirgemek kullanabilir.Bir de coklu dogrusallagi (multicollinearity) bulunan onlemek icin kullanabiliriz.Temel bilesenleri sadece numerik degiskenlere uygulayabiliriz o yüzden id ve tani degiskenini almiyoruz.
Temel Bilesenleri Olusturalım
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 3.6444 2.3857 1.67867 1.40735 1.28403 1.09880 0.82172
## Proportion of Variance 0.4427 0.1897 0.09393 0.06602 0.05496 0.04025 0.02251
## Cumulative Proportion 0.4427 0.6324 0.72636 0.79239 0.84734 0.88759 0.91010
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.69037 0.6457 0.59219 0.5421 0.51104 0.49128 0.39624
## Proportion of Variance 0.01589 0.0139 0.01169 0.0098 0.00871 0.00805 0.00523
## Cumulative Proportion 0.92598 0.9399 0.95157 0.9614 0.97007 0.97812 0.98335
## PC15 PC16 PC17 PC18 PC19 PC20 PC21
## Standard deviation 0.30681 0.28260 0.24372 0.22939 0.22244 0.17652 0.1731
## Proportion of Variance 0.00314 0.00266 0.00198 0.00175 0.00165 0.00104 0.0010
## Cumulative Proportion 0.98649 0.98915 0.99113 0.99288 0.99453 0.99557 0.9966
## PC22 PC23 PC24 PC25 PC26 PC27 PC28
## Standard deviation 0.16565 0.15602 0.1344 0.12442 0.09043 0.08307 0.03987
## Proportion of Variance 0.00091 0.00081 0.0006 0.00052 0.00027 0.00023 0.00005
## Cumulative Proportion 0.99749 0.99830 0.9989 0.99942 0.99969 0.99992 0.99997
## PC29 PC30
## Standard deviation 0.02736 0.01153
## Proportion of Variance 0.00002 0.00000
## Cumulative Proportion 1.00000 1.00000
Burada prcom komutuyla temel bilesenleri kolay bir sekilde hesaplayabildik.Bu komutla veriyi hem olcekleyip hemde merkezlemis oluyoruz.
Pca ya bakarsak ozvektor ve ozdegerlerden olustugunu gorebiliriz.
## PC1 PC2 PC3 PC4 PC5 PC6
## radius_mean -0.2189024 0.2338571 -0.008531243 0.04140896 -0.03778635 0.01874079
## PC7 PC8 PC9 PC10
## radius_mean -0.1240883 0.007452296 -0.2231098 0.09548644
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8
## [1,] -9.184755 -1.94687 -1.122179 3.630536 1.194059 1.410184 2.157472 0.398057
## PC9 PC10
## [1,] -0.1569802 -0.8766305
## [1] 3.64439401 2.38565601 1.67867477 1.40735229 1.28402903 1.09879780
## [7] 0.82171778 0.69037464 0.64567392 0.59219377 0.54213992 0.51103950
## [13] 0.49128148 0.39624453 0.30681422 0.28260007 0.24371918 0.22938785
## [19] 0.22243559 0.17652026 0.17312681 0.16564843 0.15601550 0.13436892
## [25] 0.12442376 0.09043030 0.08306903 0.03986650 0.02736427 0.01153451
Korelasyon grafigi cizdirirsek
plot1 <- cor(pca$x, method="pearson")
corrplot::corrplot(plot1, method= "color", order = "hclust", tl.pos = 'n')Temel bilesenler dik oldugundan, hicbir korelasyon yoktur. Korelasyon grafigi, otokorelasyon dısında beyazdir.
Temel Bilesenleri bulduktan sonra varyansin ne kadar acıklandigina bakmak istiyoruz.
Ana bilesen tarafindan aciklanan varyans orani (PVE) asagidaki denklem kullanilarak hesaplanir:
## [1] 0.44 0.19 0.09 0.07 0.05 0.04 0.02 0.02 0.01 0.01 0.01 0.01 0.01 0.01 0.00
## [16] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
1.temel bilesen sadece verilerdeki toplam varyansın %44’unu olusturmaktadir. 14. temel bilesenden son aciklanan varyans orani sifirdir Bu yuzden ilk 10 degisken icin varyans oranına bakariz
İlk 10 bilesenlen varyansin %95 aciklayabiliriz.Bu cok iyi bir orandir ama 10 bilesen hala fazla bunu daha da indirgemek istiyoruz.
Kumulatif olarak bakarsak
Acıklananvaryans <- function(eigen) {
par(mfrow = c(1,2))
cumsum(pca$sdev^2 / sum(pca$sdev^2))
plot(
pca$sdev^2 / sum(pca$sdev^2), pch = 21, col = 'black',
bg = '#549cc4', ylim = c(0, 1), xlab = 'Temel Bilesenler',
ylab = 'Acıklanan Varyans'
) + abline(h = 0.9)
plot(
cumsum(pca$sdev^2 / sum(pca$sdev^2)), pch = 21,
col = 'black', bg = '#549cc4', ylim = c(0, 1), xlab = 'Temel Bilesenler',
ylab = 'Acıklanan Kumulatif Varyans'
) + abline(h = 0.9)
}
Acıklananvaryans(pca)## integer(0)
Burdaki cizgi ozdegerlere gore cizilmistir ozdedegerin 1’den kucuk oldugu 0.9 degeri alinmistir.
Baktigimizda ilk 6 bilesenin % 88.8’ını acikladigini goruruz.Bu bizim icin cok iyi durumdur varyansin sadece %10’nu kaybedip Boyutsallgi 30’dan 6’ya dusurmus oluyoruz.
## [1] 0.44 0.19 0.09 0.07 0.05 0.04 0.02 0.02 0.01 0.01 0.01 0.01 0.01 0.01 0.00
## [16] 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
2 boyutta gorsellestirme yaparsak
fviz_pca_ind(pca, geom.ind = "point", pointshape = 21,
pointsize = 2,
fill.ind = veri$diagnosis,
col.ind = "black",
palette = "jco",
addEllipses = TRUE,
label = "var",
col.var = "black",
repel = TRUE,
legend.title = "Tanı") +
ggtitle("2-Boyutlu PCA Grafigi") +
theme(plot.title = element_text(hjust = 0.5))Temel Bilesenleri kullanarak cok boyutlu verileri nasıl gorsellestirileceginin iyi bir ornegidir. Aslinda sadece bunlari kullanarak tum veri kumesindeki %63.3 (Dim1% 44.3 + Dim2%19) varyansi yakalariz. Orijinal verilerin herhangi bir anlamli sekilde cizilmesi imkansiz olan (30 ozellikten olustugu dikkate alindıginda) oldukca iyi iki temel bileşendir.
Sadece ilk iki bilesenle iyi huylu ve kotu huylu tumorler arasinda bir miktar ayrim oldugunu acıkca görebiliriz.
Bu verilerin bir tur siniflandirma modeli icin cok uygun oldugunun gostergesidir.
Temel Bilesenlerle Yuz Tanima
Temel bilesen yuksek boyutlu verilerde kullanilir.Yuz tanıma icin ise buyuk bir matrisi sikistirip daha dusuk bir boyuta getirecegiz. Burada 32 × 32 faceData matrisini kullanacagiz.
Sekil 1: facedatamatrix
Temel bilesenleri hesaplayalim
load('~/Downloads/face.rda')
runPCA <- function(mat = 'Unadjusted matrix') eigen(cov(apply(mat, 2, function(i) i - mean(i))))
pca2 <- runPCA(faceData)Burada temel bilesenler hesaplanir veri stardartlastiilir.
Aciklanan varyans oranina bakmak istersek
Aciklananvaryans2 <- function(eigenList) {
par(mfrow = c(1,2))
plot(
eigenList$value / sum(eigenList$value), pch = 21, col = 'black',
bg = '#549cc4', ylim = c(0, 1), xlab = 'Temel Bilesenler',
ylab = 'Acıklanan Varyans'
) + abline(h = 0.9)
plot(
cumsum(eigenList$value) / sum(eigenList$value), pch = 21,
col = 'black', bg = '#549cc4', ylim = c(0, 1), xlab = 'Temel Bilesenler',
ylab = 'Acıklanan Kumulatif Varyans'
) + abline(h = 0.9)
}
Aciklananvaryans2(pca2)## integer(0)
Bu grafiklerden, faceData’nın toplam varyansın kumulatif olarak % 90’ını aciklayan 5. temel bilesendir. Matrisi yeniden yapilandirarak ve orijinali ile karsilastirmak icin kullanalim.
afterPCA <- function(
matAdjust = 'Centered matrix',
meanList = 'List of column means of original (unadjusted) matrix',
eigenList = 'List of eigenvalues and eigenvectors of adjust matrix covariance matrix',
n = 'selected PC\'s',
specific_select = 'If True: n == 1:n, if False: just n\'th columns') {
if (length(n) > ncol(matAdjust)) stop('N is higher than the number of PC\'s')
if (!specific_select & length(n) > 1) stop('Use a single number when selecting up to n\'th PC')
if (!specific_select) n <- 1:n
t(eigenList$vectors[,n] %*% (t(eigenList$vectors[,n]) %*% t(matAdjust))) + t(matrix(meanList, nrow = nrow(matAdjust), ncol = ncol(matAdjust)))
}
showMatrix <- function(x, ...) image(t(x[nrow(x):1,]), xaxt = 'none', yaxt = 'none', col = rev(colorRampPalette(brewer.pal(7, 'Blues'))(100)), ...)
reconstMatrix <- afterPCA(
matAdjust = apply(faceData, 2, function(i) i - mean(i)),
meanList = apply(faceData, 2, mean),
eigenList = pca2,
n = 5,
specific_select = FALSE
)
par(mfrow = c(1,2), mar = c(0, 0, 1, 0), bty = 'n')
showMatrix(faceData, main = 'Original Matrix')
showMatrix(reconstMatrix, main = 'First 5 PC\'s')Sonuca baktigimizda orjinal matrise cok yakin oldugunu gormekteyiz.5 temel bilesenlenle varyansin %90 aciklandigi icin orjinal matrise cok yakin goruntu elde etmis olduk. Yuksek boyutlu verilerde alandan tassarruf etmek icin de kullanılır.
Bagimsiz Bilesenler Analizi
İki Bagimsiz Tonu Dogrusal Karisimlarindan Cikarma Katki Gauss Gurultusunun Bozulmus Tonlarinin Uretilmesi
ICA, bagimsiz kaynakları karısık bir sinyalden ayırmak icin kullanılan bir makine ögrenme teknigidir. Oncelikli olarak ICA bagimsiz bilesenlere odaklanır, uygulamamızda bagimsiz iki farklı ton olarak adlandirilabilecek iki farklı matris olusturuyoruz.
ton1=0.7*sin((1:1000)/19+0.57*pi) + MASS::mvrnorm(n = 1000, mu = 0, Sigma = 0.004) # Tone 1 corrupted by noise
ton1 <- as.numeric(ton1)
plot(ton1, main = "Katkı Gürültüsü - Bozuk Ton 1", xlab = "Zaman", ylab = "Genlik")ton2=sin((1:1000)/33) + MASS::mvrnorm(n = 1000, mu = 0.03, Sigma = 0.005) # Tone 2 corrupted by noise
ton2 <- as.numeric(ton2)
plot(ton2, main = "Katkı Gürültüsü - Bozuk Ton 2", xlab = "Zaman", ylab = "Genlik")Olusturulan bagimsiz tonların ayni anda ciktigini varsaydigimizda farklı bir matris A tarafindan verilen konum ve ayarlara göre karisik iki farkli sinyal uretir. Uretilen iki farkli sinyali asagidaki gibi dogrusal karisik sinyal olarak belirtiyoruz. Aslinda üretilen ton1 ve ton2 iki farkli sinyal üretmiştir diyebiliriz.
Deterministik Dogrusal Karıstırma
signal1 <- ton1-2*ton2
plot(signal1, xlab = "Zaman", ylab = "Genlik",col="gray34")+
title(main = "Doğrusal Karışık Sinyal", sub = "Sinyal 1",
xlab = "Zaman", ylab = "Genlik",
cex.main = 1.3, font.main= 4, col.main= "lightcoral",
cex.sub = 0.75, font.sub = 2, col.sub = "indianred3",
col.lab ="indianred3" )## integer(0)
signal2 <- 1.73*ton1 +3.41*ton2
plot(signal2, xlab = "Zaman", ylab = "Genlik", col="gray34")+
title(main = "Dogrusal Karisik Sinyal", sub = "Sinyal 2",
xlab = "Zaman", ylab = "Genlik",
cex.main = 1.3, font.main= 4, col.main= "lightcoral",
cex.sub = 0.75, font.sub = 3, col.sub = "lightpink4",
col.lab ="lightpink4"
)## integer(0)
Karisik sinyaller(sinyal1 ve sinyal2) cikti olarak sinyal adini verdigimiz vektörü üretir.Buna kokteyl partisi sorunu diyoruz.
Sekil2: Koktely Partisi Sorunu
imdi, ton1 ve ton2’yi sinyal1 ve sinyal2’den ayırmak istiyoruz. Bunun icin bagimsiz bilesen analizi yontemini kullaniyoruz.
FastICA () kullanarak ICA gerceklestirme
library(fastICA)
b <- fastICA(Signal, 2, alg.typ = "parallel", fun = "logcosh", alpha = 1,
method = "C", row.norm = FALSE, maxit = 200,
tol = 0.0001, verbose = TRUE)## Centering
## Whitening
## Symmetric FastICA using logcosh approx. to neg-entropy function
## Iteration 1 tol=0.056372
## Iteration 2 tol=0.000061
## List of 5
## $ X: num [1:1000, 1:2] 0.779 0.42 0.698 0.56 0.594 ...
## $ K: num [1:2, 1:2] -0.167 0.309 1.033 0.559
## $ W: num [1:2, 1:2] 0.988 -0.153 -0.153 -0.988
## $ A: num [1:2, 1:2] -1.455 -0.532 2.415 -0.785
## $ S: num [1:1000, 1:2] -0.00693 0.13289 0.0055 0.05332 0.15565 ...
Logcosh kullanarak simetrik FastICA yaklasimi entropi fonksiyonuna giris icin yineleme ciktilarimizi gorebiliriz. 3 farkli yineleme ciktisi vardir.
Tahmini Ton ve Kaynak Sinyaller
ICA gerceklesmesinden sonra artik karisik iki tonun birbirinden nasil ayrildigini gözlemlemek icin bir grafik cizdiriyoruz. Grafikte gördügümüz gibi, Kirmizi ve mavi kaynak sinyalleri(yani, signal1 ve signal2’yi temsil ediyor.), yesil ve siyah ise tahmini tonları(yani, ton1 ve ton2’yi temsil etmektedir.) ifade etmektedir. Buradan anlasildigi üzere ICA yaklasimi ton1 ve ton2’yi dogru bir sekilde ayirmistir diyebiliriz.
plot(b$S[,1], col="olivedrab3", main = "Kaynak Sinyaller ve Tahmini Tonlar", xlab = "Zaman", ylab = "GEnlik") # first column of S_hat
mtext("Kırmızı ve Mavi Kaynak Sinyaller, Yeşil ve Siyah Tahmini Tonlar")
lines(ton1, col="red3")
lines(b$S[,2], col="black") # second column of S_hat
lines(ton2, col="lightslateblue")